home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / byte0787.arc / IWPAS.ARC / FASTDOG.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1987-04-28  |  3.8 KB  |  140 lines
  1. PROGRAM FastDog(input,output,picfile);
  2.  
  3. { Copyright (c) 1987, Ciarcia's Circuit Cellar          }
  4. {    All Rights Reserved                                }
  5.  
  6. {$U- control-break checking during execution            }
  7. {$C- control-break checking during I/O operations       }
  8. {$R- array range checking                               }
  9.  
  10. {$Ideclares.p                   declarations            }
  11. {$Ihexutil.p                    hex utilities           }
  12. {$Iserial.p                     serial interface code   }
  13. {$Ipictures.p                   picture file code       }
  14. {$Iimages.p                     image processing        }
  15.  
  16. CONST
  17.  BEL        = $07;              { bell character        }
  18.  manual     = FALSE;            { true for relay box    }
  19.  
  20. VAR
  21.  level      : INTEGER;          { delta threshold       }
  22.  changes    : REAL;             { # changed threshold   }
  23.  npels      : REAL;             { # actually changed    }
  24.  valerror   : INTEGER;          { error code from Val   }
  25.  picswap    : picptr;           { used to swap buffers  }
  26.  
  27. BEGIN
  28.  
  29.  LowVideo;
  30.  
  31.  IF ParamStr(1) = ''            { extract delta thresh  }
  32.   THEN BEGIN
  33.    Write('Threshold (0-63): ');
  34.    Readln(level);
  35.    IF level > 63
  36.     THEN level := 63;
  37.    IF level < 0
  38.     THEN level := 0;
  39.    valerror := 0;
  40.   END
  41.   ELSE Val(ParamStr(1),level,valerror);
  42.  
  43.  IF valerror <> 0
  44.   THEN BEGIN
  45.    Writeln('Threshold must be numeric: ',ParamStr(1));
  46.    Halt;
  47.   END;
  48.  
  49.  IF ParamStr(2) = ''            { extract # changes thr }
  50.   THEN BEGIN
  51.    Write('# Changes (0-62464): ');
  52.    Readln(changes);
  53.    IF changes > 62464.0
  54.     THEN changes := 62464.0;
  55.    IF changes < 0.0
  56.     THEN changes := 0.0;
  57.    valerror := 0;
  58.   END
  59.   ELSE Val(ParamStr(2),changes,valerror);
  60.  
  61.  IF valerror <> 0
  62.   THEN BEGIN
  63.    Writeln('# Changes must be numeric: ',ParamStr(2));
  64.    Halt;
  65.   END;
  66.  
  67.  IF manual
  68.   THEN BEGIN
  69.    Writeln('Make sure the transmitter is connected ' +
  70.            'to the serial port!');
  71.    Write('Press Enter when ready: ');
  72.    Readln;
  73.   END;
  74.  
  75.  ComOn(bitsec);                 { set up serial port    }
  76.  
  77.  pic0 := NIL;                   { get working buffer    }
  78.  PicSetup(pic0);
  79.  
  80.  pic1 := NIL;                   { get ref pic buffer    }
  81.  PicSetup(pic1);
  82.  
  83.  pic2 := NIL;                   { get test pic buffer   }
  84.  PicSetup(pic2);
  85.  
  86.  pic3 := NIL;                   { get changes buffer    }
  87.  PicSetup(pic3);
  88.  SetSyncs(pic3);                {  ... and add controls }
  89.  
  90.  Writeln('Loading reference picture...');
  91.  GetPicture(pic0,fullres);      { grab reference image  }
  92.  Expand(pic0,pic1);
  93.  
  94.  REPEAT
  95.  
  96.   Writeln('Loading test picture...');
  97.   GetPicture(pic0,fullres);     { grab test picture     }
  98.   IF NOT manual
  99.    THEN BEGIN
  100.     Writeln('  displaying');
  101.     SendPicture(pic0);      { show if relay box on  }
  102.    END;
  103.  
  104.   Writeln('  expanding');
  105.   Expand(pic0,pic2);
  106.  
  107.   Writeln('Comparing test with reference...');
  108.   Compare(pic1,pic2,pic3);      { find changes          }
  109.  
  110.   Write('Counting differences...  ');
  111.   npels := CountPels(pic3,level);
  112.   Writeln(npels:8:0,' pels >= ',level,' brightness');
  113.  
  114.   IF npels >= changes
  115.    THEN BEGIN
  116.     Writeln('**** Intruder detected!!! ',Chr(BEL));
  117.     IF manual
  118.      THEN BEGIN
  119.       Writeln('Switch cables to show image');
  120.       Write('Press Enter when ready: ');
  121.       Readln;
  122.       SendPicture(pic0);
  123.       Halt;
  124.      END
  125.      ELSE BEGIN
  126.       Writeln('Showing differences');
  127.       SendPicture(pic3);
  128.      END;
  129.    END
  130.    ELSE Writeln('---- No intruder so far');
  131.  
  132.   Writeln('Resetting reference picture...');
  133.   picswap := pic1;              { set ref = test        }
  134.   pic1 := pic2;
  135.   pic2 := picswap;              { will be overwritten   }
  136.  
  137.  UNTIL KeyPressed;
  138.  
  139. END.
  140.